Gigarom 1/Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso/FILES/HYP/C-D/DartmouthXCMDs.cpt/Dartmouth XCMDs Vol 1&2/card_2454.txt

Text File | 1989-02-26 | 22KB | 612 lines

-- card: 2454 from stack: in
-- bmap block id: 0
-- flags: 0000
-- background id: 3241
-- name:


-- part 3 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=64 top=300 right=322 bottom=202
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: DeleteResFork
----- HyperTalk script -----
on mouseUp
  -- This button uses the DeleteResFork XCMD to delete the
  -- resource fork of a stack.
  deleteresfork
  put the result
end mouseUp



-- part 4 (field)
-- low flags: 80
-- high flags: 2007
-- rect: left=12 top=26 right=298 bottom=491
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 22
-- text size: 10
-- style flags: 0
-- line height: 13
-- part name: Source


-- part 5 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=314 top=300 right=322 bottom=435
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Show LSP Source
----- HyperTalk script -----
on mouseUp
  set the visible of card field 1 to not the visible of card field 1
  if the visible of card field 1 is true then
    set the name of me to "Hide LSP Source"
  else set the name of me to "Show LSP Source"
end mouseUp



-- part contents for background part 16
----- text -----
DELETERESFORK XCMD version 1.0
July 7, 1988
Kevin Calhoun

DeleteResFork deletes the resource fork of a stack while leaving the data fork intact.

Each Macintosh file, including HyperCard stacks, has two forks--a resource fork and a data fork, either of which may be empty.  HyperCard stores all the information about buttons, fields, text, and pictures in the data fork of your stacks.  XCMD's, XFCN's, PICT's, and other resources are stored in the resource fork.

DeleteResFork is for that trying moment when you discover that the resource fork of a stack has been ruined.  If this should occur, all of the data HyperCard relies on will still be intact--it's stored in the data fork--but you'll need to jettison your garbled resource fork and then recopy the necessary resources.

How can you tell if the resource fork has been ruined?  If ResEdit tells you that there was an error while opening the stack or if a disk utility tells you that the resource fork still takes up disk space even though HyperCard can't find the resources, then you know that your resource fork has been compromised.  (Sometimes HyperCard can't find newly copied resources until you close the stack and then reopen it.  Don't panic until after you've tried this.)

DeleteResFork won't let you regain access to a ruined resource fork.  Instead, it just gets rid of it.  It lets you "shake loose" a worthless resource fork that can't be read and start afresh.

NOTE:  It's unwise to delete the resource fork of a stack that is already open.  Make a copy of the stack and then work on the copy.

INVOKING DELETERESFORK

DeleteResFork «fileName»

DeleteResFork takes one optional parameter, the full pathname of the file whose resource fork you want to delete.  If the file name is not supplied, a standard file dialog box appears, from which you can select a stack.

If the file name supplied is not the full pathname of an extant stack, or if there is any other error, DeleteResFork will return an error message as the Result.  The first word of this message will be "Error."

NOTE FOR ADVANCED PROGRAMMERS:
Because XCMD's have no "owned resources" and because there's no official "XCMD Mover," you can never count on resources such as DITL's or STR#'s being around when you need them.  The PrintField XCMD checks for the presence of the proper resources for its dialog.  If they're there it displays its dialog; otherwise it goes ahead and prints without the dialog.  With DeleteResFork, I took a different approach--it creates a dialog without using a DITL resource for the dialog item list.

The functions AddButton, AddUserItem, and AddStatText append a new item to a dialog item list in memory.  The function MakeDITL uses these to build an item list from scratch.
(Roger tells me that Tech Note #95, How To Add Items to the Print Dialogs, includes some code that handles the general case of adding an item to an item list.)

The drawback to creating a dialog item list on the fly without resources is that you can't alter the text of the dialog (other than the paramText) without recompiling the source code.  However, in the case of XCMD's it may be more valuable to be certain that a vital resource isn't missing than it is to enable alteration of titles and text without source code.

Perhaps the ideal solution is to include both the resources and the code to create them on the fly.  If the resources are present, go ahead.  If not, create them.

DeleteResFork also contains a filter for ModalDialog that handles the usual keyboard equivalents for Cancel (command-period, command-q, command-Q, escape, tilde) and OK (return and enter).

-- part contents for card part 4
----- text -----
UNIT DeleteResFork;
{ DeleteResFork XCMD ©1988 by the Trustees of Dartmouth College. }
{ Written by John K. Calhoun, Courseware Development. }

INTERFACE
  USES
    XCMDIntf;
  TYPE
    Str31 = STRING[31];

{ type declarations for creating dialog items }
    dItemPtr = ^dialogItem;
    dItemHndl = ^dItemPtr;
    dialogItem = RECORD
        placeholder : handle;
        displayRect : Rect;
        typeAndDataLength : INTEGER;
      END;

  PROCEDURE main (paramPtr : XCMDPtr);

IMPLEMENTATION

{-----------------------------------------------------------------}

{ The following routines are from the file XCMDUtilities.p. }
{ Instead of including the entire XCMD utilities file, }
{ we add to our code only the ones we actually need. }
{ This trims the size of our XCMD. }

  PROCEDURE DoJsr (addr : ProcPtr);
  INLINE
    $205F, $4E90;

  FUNCTION EvalExpr (paramPtr : XCmdPtr;
                  expr : Str255) : Handle;
  BEGIN
    WITH paramPtr^ DO
      BEGIN
        inArgs[1] := ORD(@expr);
        request := xreqEvalExpr;
        DoJsr(entryPoint);
        EvalExpr := Handle(outArgs[1]);
      END;
  END;

  PROCEDURE ZeroToPas (paramPtr : XCmdPtr;
                  zeroStr : Ptr;
                  VAR pasStr : Str255);
  BEGIN
    WITH paramPtr^ DO
      BEGIN
        inArgs[1] := ORD(zeroStr);
        inArgs[2] := ORD(@pasStr);
        request := xreqZeroToPas;
        DoJsr(entryPoint);
      END;
  END;

  FUNCTION StrToNum (paramPtr : XCmdPtr;
                  str : Str31) : LongInt;
  BEGIN
    WITH paramPtr^ DO
      BEGIN
        inArgs[1] := ORD(@str);
        request := xreqStrToNum;
        DoJsr(entryPoint);
        StrToNum := outArgs[1];
      END;
  END;

  FUNCTION NumToStr (paramPtr : XCmdPtr;
                  num : LongInt) : Str31;
    VAR
      str : Str31;
  BEGIN
    WITH paramPtr^ DO
      BEGIN
        inArgs[1] := num;
        inArgs[2] := ORD(@str);
        request := xreqNumToStr;
        DoJsr(entryPoint);
        NumToStr := str;
      END;
  END;

  FUNCTION PasToZero (paramPtr : XCmdPtr;
                  str : Str255) : Handle;
  BEGIN
    WITH paramPtr^ DO
      BEGIN
        inArgs[1] := ORD(@str);
        request := xreqPasToZero;
        DoJsr(entryPoint);
        PasToZero := Handle(outArgs[1]);
      END;
  END;

{-----------------------------------------------------------------}

  PROCEDURE GetEventMask (VAR theMask : INTEGER);
{ returns the current event mask in theMask }
    CONST
      SysEvtMask = $144;
    TYPE
      IntegerPtr = ^INTEGER;
    VAR
      myIntPtr : IntegerPtr;
  BEGIN
    myIntPtr := IntegerPtr(SysEvtMask);
    theMask := myIntPtr^;
  END;

  PROCEDURE PassReturnValue (paramPtr : XCMDPtr;
                  theMsg : Str255); { set theResult }
  BEGIN
    paramPtr^.returnValue := PasToZero(paramPtr, theMsg);
  END;

  FUNCTION GetLocOfCardWindow (paramPtr : XCmdPtr) : point;
{ returns the top left corner of the card window }
    VAR
      theResult : Handle;
      aString : Str255;
      theLoc : point;
  BEGIN
    theResult := EvalExpr(paramPtr, 'item 1 of the loc of card window');
    ZeroToPas(paramPtr, theResult^, aString);
    DisposHandle(theResult);
    theLoc.h := StrToNum(paramPtr, aString);

    theResult := EvalExpr(paramPtr, 'item 2 of the loc of card window');
    ZeroToPas(paramPtr, theResult^, aString);
    DisposHandle(theResult);
    theLoc.v := StrToNum(paramPtr, aString);
    GetLocOfCardWindow := theLoc;
  END;

  FUNCTION MyFilter (theDialog : DialogPtr;
                  VAR theEvent : EventRecord;
                  VAR itemHit : INTEGER) : BOOLEAN;
{ filter function for modal dialog -- handles the usual key equivalents for OK and Cancel }
    VAR
      theChar : char;
      dummy : EventRecord;

    PROCEDURE PushButton (itemNo : INTEGER);
{ Hilites the button itemNo while a key is pressed. }
{ For this to work properly, the event mask must be set to allow }
{ keyUp events to be detected -- that's why the call to ModalDialog, }
{ below, is bracketed by calls to SetEventMask. }
      VAR
        itemType : INTEGER;
        itemHandle : Handle;
        itemBox : Rect;
    BEGIN  { procedure PushButton }
      GetDItem(theDialog, itemNo, itemType, itemHandle, itemBox);
      HiliteControl(ControlHandle(itemHandle), inButton);
      REPEAT
      UNTIL OSEventAvail(keyUpMask, dummy);
      HiliteControl(ControlHandle(itemHandle), 0);
    END;

  BEGIN  { function MyFilter }
    MyFilter := FALSE;
    CASE theEvent.what OF
      keyDown, autoKey :
        BEGIN
          theChar := CHR(BitAnd(theEvent.message, charCodeMask));
          IF BitAnd(theEvent.modifiers, cmdKey) <> 0 THEN
            BEGIN
              MyFilter := TRUE;
              CASE ORD(theChar) OF
                46, 81, 113 :
{ if user pressed command-period, -q, or -Q, then do Cancel }
                  BEGIN
                    PushButton(Cancel);
                    itemHit := Cancel;
                    MyFilter := TRUE;
                  END;
              END;
            END
          ELSE
            CASE ORD(theChar) OF
              13, 3 :
{ if the user pressed return or enter, do OK }
                BEGIN
                  PushButton(OK);
                  itemHit := OK;
                  MyFilter := TRUE;
                END;
              27, 96 :
{ if user pressed the escape key or the tilde key, do Cancel }
                BEGIN
                  PushButton(Cancel);
                  itemHit := Cancel;
                  MyFilter := TRUE;
                END;
            END;
        END;
    END;
  END;

  PROCEDURE DrawBoxAroundDefault (theWindow : WindowPtr;
                  itemNo : INTEGER);
{ draws the bold rounded-corner rect around the default button }
    VAR
      itemType : integer;
      itemHdl : Handle;
      itemBox : rect;
  BEGIN
    GetDItem(theWindow, 1, itemType, itemHdl, itemBox);
    PenSize(3, 3);
    InsetRect(itemBox, -4, -4);
    FrameRoundRect(itemBox, 16, 16);
    PenSize(1, 1);
  END;

  PROCEDURE DrawVersionInfo (theWindow : WindowPtr;
                  itemNo : INTEGER);
{ draws the version info for the XCMD in the dialog box }
    VAR
      itemType : integer;
      itemHdl : Handle;
      itemBox : rect;
      str : Str255;
  BEGIN
    str := 'DeleteResFork XCMD 1.0   ©1988 Dartmouth College';
    GetDItem(theWindow, itemNo, itemType, itemHdl, itemBox);
    TextFont(Geneva);
    TextSize(9);
    TextBox(POINTER(ORD(@str) + 1), LENGTH(str), itemBox, teJustLeft);
    TextFont(SystemFont);
    TextSize(12);
  END;

  FUNCTION AddButton (boundsRect : rect;
                  title : Str255;
                  VAR theItems : Handle) : OSErr;
{ add information for a new button item to the end of the DITL theItems }
    VAR
      newItem : DItemHndl;
      err : OSErr;
  BEGIN
    newItem := DItemHndl(NewHandle(SIZEOF(DialogItem)));
    err := MemError;
    IF (newItem <> NIL) AND (err = noErr) THEN
      BEGIN
        MoveHHi(Handle(newItem));
        HLock(Handle(newItem));
        WITH newItem^^ DO
          BEGIN
            placeholder := NIL;
            displayRect := boundsRect;  { item rectangle }
            typeAndDataLength := (ctrlItem + btnCtrl) * 256 + LENGTH(title);
             { high byte contains itemType, low byte contains length of
                   the button title }
          END;
        err := HandAndHand(Handle(newItem), theItems);  { copy this info into item list }
        IF err = noErr THEN
          err := PtrAndHand(POINTER(ORD4(@title) + 1), theItems, LENGTH(title));
               { copy the title into the item list }
        HUnlock(Handle(newItem));
        DisposHandle(Handle(newItem));
      END;
    AddButton := err;
  END;

  FUNCTION AddUserItem (boundsRect : rect;
                  theProc : ProcPtr;
                  VAR theItems : Handle) : OSErr;
{ add information for a new user item to the end of the DITL theItems }
    VAR
      theUserItem : DItemHndl;
      err : OSErr;
  BEGIN
    theUserItem := DItemHndl(NewHandle(SIZEOF(DialogItem)));
    err := MemError;
    IF (theUserItem <> NIL) AND (err = noErr) THEN
      BEGIN
        MoveHHi(Handle(theUserItem));
        HLock(Handle(theUserItem));
        WITH theUserItem^^ DO
          BEGIN
            placeholder := Handle(theProc);
            displayRect := boundsRect;  { item rectangle }
            typeAndDataLength := userItem * 256 + 0;
             { high byte contains itemType, low byte contains nothing }
          END;
        err := HandAndHand(Handle(theUserItem), theItems);
          { copy this info into the item list }
        HUnlock(Handle(theUserItem));
        DisposHandle(Handle(theUserItem));
      END;
    AddUserItem := err;
  END;

  FUNCTION AddStatText (boundsRect : rect;
                  str : Str255;
                  VAR theItems : Handle) : OSErr;
{ add information for a new statText item to the end of the DITL theItems }
    VAR
      theStatTextItem : DItemHndl;
      err : OSErr;
  BEGIN
    theStatTextItem := DItemHndl(NewHandle(SIZEOF(DialogItem)));
    err := MemError;
    IF (theStatTextItem <> NIL) AND (err = noErr) THEN
      BEGIN
        MoveHHi(Handle(theStatTextItem));
        HLock(Handle(theStatTextItem));
        WITH theStatTextItem^^ DO
          BEGIN
            placeholder := NIL;
            displayRect := boundsRect;  { item rectangle }
            typeAndDataLength := (statText + itemDisable) * 256 + LENGTH(str);
             { high byte contains itemType, low byte contains length of
                   the text to be displayed }
          END;
        err := HandAndHand(Handle(theStatTextItem), theItems);
          { copy this info into the item list }
        IF err = noErr THEN
          err := PtrAndHand(POINTER(ORD4(@str) + 1), theItems, LENGTH(str));
               { copy the text into the item list }
        HUnlock(Handle(theStatTextItem));
        DisposHandle(Handle(theStatTextItem));
      END;
    AddStatText := err;
  END;

  FUNCTION MakeDITL (VAR theItems : Handle) : OSErr;
{ Create our dialog item list on the fly. }
{ We rely heavily on the information given in IM-I, p. 427 }
    CONST
      numItems = 6;
    VAR
      myStatTextItem : dItemHndl;
      err : OSErr;
      itemCount : INTEGER;
      str : Str255;
      theRect : Rect;
  BEGIN
    theItems := NewHandle(2);
{ We'll build this handle into a full item list by appending info to it }
{ using BlockMove, HandAndHand, and PtrAndHand. }
    IF theItems <> NIL THEN
      BEGIN
        itemCount := numItems - 1;
        BlockMove(@itemCount, theItems^, 2);
         { first two bytes of the DITL = number of items in list minus 1 }
        SetRect(theRect, 230, 100, 300, 120);
        err := AddButton(theRect, 'OK', theItems);
          { add the OK button to the item list }
        IF err = noErr THEN
          BEGIN
            SetRect(theRect, 140, 100, 210, 120);
              { add the Cancel button to the item list }
            err := AddButton(theRect, 'Cancel', theItems);
            IF err = noErr THEN
              BEGIN
                SetRect(theRect, 220, 90, 310, 130);
                err := AddUserItem(theRect, @DrawBoxAroundDefault, theItems);
                  { add the default button user item to the item list }
                IF err = noErr THEN
                  BEGIN
                    SetRect(theRect, 10, 97, 130, 125);
                    err := AddUserItem(theRect, @DrawVersionInfo, theItems);
                      { add the version info user item to the item list }
                    IF err = noErr THEN
                      BEGIN
                        SetRect(theRect, 10, 10, 302, 50);
                        str := 'Are you sure you want to delete the resource fork of: ';
                        err := AddStatText(theRect, str, theItems);
                          { put this string in a stat text item and }
                          { add it to the item list }
                        IF err = noErr THEN
                          BEGIN
                            SetRect(theRect, 10, 52, 302, 92);
                            str := '“^0”? ';
                            err := AddStatText(theRect, str, theItems);
                              { put this string in a stat text item and }
                              { add it to the item list }
                          END;  { if err = noErr when creating the first statText item }
                      END;  { if err = noErr when creating the version info userItem }
                  END;  { if err = noErr when creating the default button userItem }
              END;  { if err = noErr when creating Cancel Button }
          END;  { if err = noErr when creating OK button }
      END; { if theItems <> nil }
    MakeDITL := err;
  END;

  PROCEDURE DoSFGet (cardLoc : Point;
                  VAR SFGetReply : SFReply);
    VAR
      where : point;
      typeList : SFTypeList;
  BEGIN  { select text file to read using SFGetFile }
{ in order to align the dialog box over the current location of the card window }
    SetPt(where, 82, 75); { tell SFGetFile where to put the dialog box }
    AddPt(cardLoc, where);  { align the dialog box with current location }
                                 { of the card window }
    typeList[0] := 'STAK'; { tell SFGetFile to display only text files }
    SFGetFile(where, '', NIL, 1, typeList, NIL, SFGetReply);
        { call SFGetFile }
  END;

  FUNCTION DeleteResourceFork (fName : Str255;
                  vRefNum : INTEGER) : OSErr;
{ delete the resource fork of a file }
    VAR
      theRefNum : INTEGER;
      closeErr, err : OSErr;
  BEGIN
    err := OpenRF(fName, vRefNum, theRefNum);  { open the file }

    IF err = noErr THEN { continue only if file could be opened }
      BEGIN
        err := SetEOF(theRefNum, 0);  { set the length of the resource fork to 0 }
        closeErr := FSClose(theRefNum);  { close the file }
      END;
    DeleteResourceFork := err;
  END; { procedure DeleteResourceFork }

  PROCEDURE SaveTheData (paramPtr : XCMDPtr);
    VAR
      cardLoc : point;
      SFGetReply : SFReply;
      err : OSErr;
      gotAFile : BOOLEAN;
      theFileName : Str255;
      theVRefNum : INTEGER;
      fndrInfo : FInfo;
      myItems : Handle;
      bounds : rect;
      myDialog : DialogPtr;
      theMask : INTEGER;
      itemHit : INTEGER;

  BEGIN { procedure SaveTheData }
    cardLoc := GetLocOfCardWindow(paramPtr);
    gotAFile := FALSE;
    IF paramPtr^.paramCount < 1 THEN
{ user did not specify a file -- put up standard file dialog box }
      BEGIN
        DoSFGet(cardLoc, SFGetReply);
        IF SFGetReply.good = TRUE THEN
          BEGIN         { continue only if user actually selected a file }
            WITH SFGetReply DO
              BEGIN
                theFileName := fName;
                theVRefNum := vRefNum;
              END;  { with SFGetReply }
            gotAFile := TRUE;
          END;
      END
    ELSE
{ user specified a file -- check to see if it's really a stack }
      BEGIN
        ZeroToPas(paramPtr, paramPtr^.params[1]^, theFileName);
        err := GetFInfo(theFileName, 0, fndrInfo);
        IF (err = noErr) AND (fndrInfo.fdType = 'STAK') THEN
          BEGIN
            gotAFile := TRUE;
            theVRefNum := 0;
          END
        ELSE IF err <> noErr THEN
          PassReturnValue(paramPtr, CONCAT('Error ', NumToStr(paramPtr, err)))
        ELSE
          PassReturnValue(paramPtr, 'Error -- that file is not a stack');
      END;
    IF gotAFile THEN
      BEGIN
{ create our dialog item list on the fly and put up our dialog }
        err := MakeDITL(myItems);
        IF err = noErr THEN
          BEGIN
{ calculate boundsRect of dialog and display it }
            WITH cardLoc DO
              SetRect(bounds, h + 100, v + 80, h + 412, v + 210);
            ParamText(theFileName, '', '', '');
            myDialog := NewDialog(NIL, bounds, '', TRUE, dBoxProc, POINTER(-1), FALSE, 0, myItems);
            GetEventMask(theMask);
            SetEventMask(everyEvent);
{ Our filter proc for ModalDialog needs keyUp events, }
{ so we set the event mask so that it gets them }
{ and then restore the event mask after the dialog is removed. }
            REPEAT
              ModalDialog(@MyFilter, itemHit);
            UNTIL (itemHit = OK) OR (itemHit = Cancel);
            SetEventMask(theMask);
            DisposDialog(myDialog);
            DisposHandle(myItems);
            IF itemHit = OK THEN
{ user gave the go-ahead, so go ahead and delete the resource fork }
              err := DeleteResourceFork(theFileName, theVRefNum);
          END;
        IF err <> noErr THEN  { return error message }
          PassReturnValue(paramPtr, CONCAT('Error ', NumToStr(paramPtr, err)));
      END; { if gotAFile }
  END;  { of procedure SaveThatData }

  PROCEDURE main;
  BEGIN
    SaveTheData(paramPtr);
  END;

END.